COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	OWN REAL PXLO,PXHI,PYLO,PYHI OWN INTEGER PPIC
C00006 00003	PROCEDURE CPOLY(INTEGER N REFERENCE REAL XV,YV REAL BRITE)
C00010 00004	IFC FALSE THENC
C00015 ENDMK
C⊗;
OWN REAL PXLO,PXHI,PYLO,PYHI; OWN INTEGER PPIC;

PROCEDURE PSCREEN(REAL XL,YL,XH,YH; REFERENCE INTEGER PC);
   BEGIN
   PXLO←XL;
   PXHI←XH;
   PYLO←YL;
   PYHI←YH;
   PPIC←LOCATION(PC);
   END;

PROCEDURE DIT(REAL X1,Y1,BRITE);
   BEGIN
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   ADDIEL(MEMORY[PPIC],Y1,X1,BRITE);
   END;

PROCEDURE THIN(REAL X1,Y1,X2,Y2,BRITE);
   BEGIN
   REAL LEN,DX,DY; REAL I; INTEGER ILEN;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   DX←X2-X1; DY←Y2-Y1; DX←DX; DY←DY;
   ILEN←LEN←SQRT(DX↑2+DY↑2);
   DX←DX/LEN; DY←DY/LEN;
   FOR I←0 STEP 0.5 UNTIL LEN DO
      ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,BRITE/2);
   COMMENT  ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE);
   END;

PROCEDURE FADE(REAL X1,Y1,X2,Y2,BRITE1,BRITE2);
   BEGIN
   REAL LEN,DX,DY; INTEGER I,ILEN;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE1←BRITE1*MEMORY[PPIC+BMAX];
   BRITE2←BRITE2*MEMORY[PPIC+BMAX];
   DX←X2-X1; DY←Y2-Y1;
   ILEN←LEN←SQRT(DX↑2+DY↑2);
   DX←DX/LEN; DY←DY/LEN;
   FOR I←0 STEP 1 UNTIL ILEN-1 DO
      ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,(BRITE2*I+BRITE1*(ILEN-I))/ILEN);
   ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE2);
   END;

PROCEDURE BALL(REAL X1,Y1,X2,Y2,BRITE);
   BEGIN
   REAL LEN,DX,DY,XR,YR,XC,YC,T;
   X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
   Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
   X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
   Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];
   XC←(X1+X2)/2;
   YC←(Y1+Y2)/2;
   XR←(X1-X2)/2;
   YR←(Y1-Y2)/2;
   T←0;
   WHILE T<2*3.14159265 DO
      BEGIN
      REAL X,Y;
      X←XR*COS(T); Y←YR*SIN(T);
      ADDIEL(MEMORY[PPIC],YC+Y,XC+X,BRITE);
      T←T+1/SQRT(X↑2+Y↑2);
      END;
   END;
PROCEDURE CPOLY(INTEGER N; REFERENCE REAL XV,YV; REAL BRITE);
   BEGIN "POLY"
   REQUIRE "{}" DELIMITERS;
   REAL XMIN,XMAX,YMIN,YMAX; INTEGER LOX,HIX,LOY,HIY,M;
   REAL ARRAY IX,IY[0:N-1];

   REAL LEDGE,LEX,LEDX,LAST;
   REAL REDGE,REX,REDX,RAST;
   INTEGER LNXT,RNXT,I,J,LINENO;
   
   DEFINE X(I)={MEMORY[LOCATION(XV)+I,REAL]};
   DEFINE Y(I)={MEMORY[LOCATION(YV)+I,REAL]};

   M←N-1;    LOX←HIX←LOY←HIY←1;
   XMIN←XMAX←IX[0]←(MEMORY[PPIC+LNBY]-1.9)*(X(0)-PXLO)/(PXHI-PXLO);
   YMIN←YMAX←IY[0]←(MEMORY[PPIC+PCLN]-1.9)*(Y(0)-PYHI)/(PYLO-PYHI);
   BRITE←BRITE*MEMORY[PPIC+BMAX];

   FOR I←1 STEP 1 UNTIL M DO
      BEGIN
      IX[I]←(MEMORY[PPIC+LNBY]-1.9)*(X(I)-PXLO)/(PXHI-PXLO);
      IY[I]←(MEMORY[PPIC+PCLN]-1.9)*(Y(I)-PYHI)/(PYLO-PYHI);
      IF IX[I]<XMIN THEN BEGIN LOX←I; XMIN←IX[I] END;
      IF IY[I]<YMIN THEN BEGIN LOY←I; YMIN←IY[I] END;
      IF IX[I]>XMAX THEN BEGIN HIX←I; XMAX←IX[I] END;
      IF IY[I]>YMAX THEN BEGIN HIY←I; YMAX←IY[I] END;
      END;

   LEDGE←REDGE←LOY;

   LEX ← IX[LEDGE]; LNXT←(LEDGE+1) MOD N;
   LEDX←(IX[LEDGE]-IX[LNXT])/(IY[LEDGE]-IY[LNXT]);
   LAST← IY[LNXT];

   REX ← IX[REDGE]; RNXT←(REDGE+N-1) MOD N;
   REDX←(IX[REDGE]-IX[RNXT])/(IY[REDGE]-IY[RNXT]);
   RAST← IY[RNXT];

   FOR LINENO←YMIN STEP 1 UNTIL YMAX DO
      BEGIN
      REAL J;

      WHILE LINENO>LAST ∧ LEDGE≠HIY DO
         BEGIN
         LEDGE←LNXT;
	 LEX ← IX[LEDGE]; LNXT←(LEDGE+1) MOD N;
  	 LEDX←(IX[LEDGE]-IX[LNXT])/(IY[LEDGE]-IY[LNXT]);
	 LAST← IY[LNXT];
         END;

      WHILE LINENO>RAST ∧ REDGE≠HIY DO
         BEGIN
         REDGE←RNXT;
	 REX ← IX[REDGE]; RNXT←(REDGE+N-1) MOD N;
	 REDX←(IX[REDGE]-IX[RNXT])/(IY[REDGE]-IY[RNXT]);
	 RAST← IY[RNXT];
         END;

      FOR J←LEX STEP 1 UNTIL REX DO PUTEL(MEMORY[PPIC],LINENO,J,BRITE);
      LEX←LEX+LEDX;
      REX←REX+REDX;
      END;

   END "POLY";
IFC FALSE THENC
PROCEDURE PIXLIN(REAL X1,Y1,X2,Y2,BR;
                 REFERENCE INTEGER PIC;
                 REAL XLO(0),YLO(0),XHI(1),YHI(1));
   BEGIN
   SAFE REAL ARRAY WT[-1:1,-1:1];
   REAL LEN,DX,DY,DTX,DTY,TX,TY,T,CON; INTEGER IX,IY,IDX,IDY;
   X1←MEMORY[LOCATION(PIC)+LNBY]*(X1-XLO)/(XHI-XLO);
   X2←MEMORY[LOCATION(PIC)+LNBY]*(X2-XLO)/(XHI-XLO);
   Y1←MEMORY[LOCATION(PIC)+PCLN]*(Y1-YLO)/(YHI-YLO);
   Y2←MEMORY[LOCATION(PIC)+PCLN]*(Y2-YLO)/(YHI-YLO);
   DX←X2-X1; DY←Y2-Y1;
   IDX←IF DX>0 THEN 1 ELSE -1;
   IDY←IF DY>0 THEN 1 ELSE -1;
   LEN←SQRT(DX↑2+DY↑2);
   DTX←ABS(LEN/(X2-X1));  DTY←ABS(LEN/(Y2-Y1));
   IX←X1; IY←Y1;
   TX←(X1-IX)/DX; IF TX<0 THEN TX←(X1-IX-1)/DX;
   TX←TX*SQRT(1+DY↑2);
   TY←(Y1-IY)/DY; IF TY<0 THEN TY←(Y1-IY-1)/DY;
   TY←TY*SQRT(1+DX↑2);
   T←0;
   BR←BR*MEMORY[LOCATION(PIC)+BMAX]/SQRT(2);
   CON←X1*Y2-X2*Y1;
   OUTSTR("BR "&CVF(BR)&"  TX "&CVF(TX)&"  TY "&CVF(TY)&"  DTX "&CVF(DTX)&"  DTY "&CVF(DTY)&'15&'12);
   WHILE T<LEN DO IF TX+DTX<TY+DTY THEN
      BEGIN
      INTEGER II,JJ; REAL VAL;
      TX←(TX+DTX) MIN LEN;
      VAL←0;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         BEGIN
         WT[II,JJ]←(LEN-ABS((II+IY)*DX-(JJ+IX)*DY+CON)) MAX 0;
         VAL←VAL+WT[II,JJ];
         END;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         ADDEL(PIC,II+IY,JJ+IX,BR*(TX-T)*WT[II,JJ]/VAL);
      T←TX;
      IX←IX+IDX;
      END
   ELSE
      BEGIN
      INTEGER II,JJ; REAL VAL;
      TY←(TY+DTY) MIN LEN;
      VAL←0;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         BEGIN
         WT[II,JJ]←(LEN-ABS((II+IY)*DX-(JJ+IX)*DY+CON)) MAX 0;
         VAL←VAL+WT[II,JJ];
         END;
      FOR II←-1,0,1 DO
      FOR JJ←-1,0,1 DO
         ADDEL(PIC,II+IY,JJ+IX,BR*(TX-T)*WT[II,JJ]/VAL);
      T←TY;
      IY←IY+IDY;
      END;
   END;

PROCEDURE PICLIN(REAL X1,Y1,X2,Y2,BR;
                 REFERENCE INTEGER PIC;
                 REAL XLO(0),YLO(0),XHI(1),YHI(1));
   BEGIN
   REAL LEN,DX,DY,DTX,DTY,TX,TY,T; INTEGER IX,IY,IDX,IDY;
   X1←MEMORY[LOCATION(PIC)+LNBY]*(X1-XLO)/(XHI-XLO);
   X2←MEMORY[LOCATION(PIC)+LNBY]*(X2-XLO)/(XHI-XLO);
   Y1←MEMORY[LOCATION(PIC)+PCLN]*(Y1-YLO)/(YHI-YLO);
   Y2←MEMORY[LOCATION(PIC)+PCLN]*(Y2-YLO)/(YHI-YLO);
   DX←X2-X1; DY←Y2-Y1;
   IDX←IF DX>0 THEN 1 ELSE -1;
   IDY←IF DY>0 THEN 1 ELSE -1;
   LEN←SQRT(DX↑2+DY↑2);
   DTX←ABS(LEN/(X2-X1));  DTY←ABS(LEN/(Y2-Y1));
   IX←X1; IY←Y1;
   TX←(X1-IX)/DX; IF TX<0 THEN TX←(X1-IX-1)/DX;
   TX←TX*SQRT(1+DY↑2);
   TY←(Y1-IY)/DY; IF TY<0 THEN TY←(Y1-IY-1)/DY;
   TY←TY*SQRT(1+DX↑2);
   T←0;
   BR←BR*MEMORY[LOCATION(PIC)+BMAX]/SQRT(2);
   OUTSTR("BR "&CVF(BR)&"  TX "&CVF(TX)&"  TY "&CVF(TY)&"  DTX "&CVF(DTX)&"  DTY "&CVF(DTY)&'15&'12);
   WHILE T<LEN DO IF TX+DTX<TY+DTY THEN
      BEGIN
      TX←(TX+DTX) MIN LEN;
      ADDEL(PIC,IY,IX,(TX-T)*BR);
      T←TX;
      IX←IX+IDX;
      END
   ELSE
      BEGIN
      TY←(TY+DTY) MIN LEN;
      ADDEL(PIC,IY,IX,(TY-T)*BR);
      T←TY;
      IY←IY+IDY;
      END;
   END;
ENDC